00100		SUBROUTINE SCMSS
00110		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,LL,IS,IX
00300	       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
00350	C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
00500		DIMENSION RLIST(200),NOMOR(6),WARN(6),R(10,80),ISV(5)
00550	C  /SCX/ ALSO IN WORDS, NEWR
00600		COMMON/SCX/RHY(4),JALPHA(22),RB,RC,JZ,IRHY,JD,KA,KB,IZ
00610		1/STF/RSTFAC(8),RSTJ2/FRMT/F78F(1),FA1(1),FA5(1),IREAD
00700		1/XRN/RN(4000) /ALF/INP(72),ML 
00800		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
00900		1,NFLG,IXX,ISEMI,JG,VX(50),IAMP,K,KN,M,MODE,IBLA
01100	      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3))
01200		1,(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST),(R,RN(3001))
01300		1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4)),(IBEAM,RN(3000))
01400		1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,
01410		1 JALPHA(6)),(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),
01420		1 (IDOT,JALPHA(3)),(RMODE2,RN(3918)),(SET4,RN(3920))
01500		DATA KSLA/'/'/,IXX/'X'/,LCNT/1/,RHY/.5,.25,.125,.0625/
01600		1,ISEMI/';'/
01900	1177	IF(JA.EQ.14)GO TO 77
01950		IF(JA.NE.144)GO TO 11
02000	77	MODE=1
02050		RMODE2=R3
02060		TYPE 444,SET4
02100		IBEAM=-1
02200		IZ=0
02300		IREAD=0
02400	11	IF(IREAD)GO TO 2302
02500		IF(JA.NE.144)GO TO (1,2,3,4,5,69)MODE
02600	2302	TYPE 80053
02650		IF(IREAD)REREAD 21141,L,INP
02700		IF(IREAD.EQ.0)TYPE 80051
02800		ACCEPT 80052,STAFF,L
02810		IF(STAFF.NE.444)GO TO 2177
02820	3177	REREAD 4177,SET4,SET4
02830	C NOW SPACER CAN BE SET AT THIS POINT
02840		GO TO 1177
02845	4177	FORMAT(2F)
02850	2177	IF(STAFF.GE.99)GO TO 69
02875	C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
02887		REND=0
02900		IF(IREAD)GO TO 80041
02950		IF(LOOK(L)+LOOKD(L).EQ.0)GO TO 2302
03000		IREAD=-1
03055	C FOR 1ST TIME IN BEAMS.
03100		REWIND 22
03200		CALL IFILE(22,L)
03300	2301	READ(22,21141,END=68),L,INP
03400		IF(MODE.EQ.6)GO TO 1111
03500		IF(INP1.EQ.IBLA)GO TO 8006
03600		GO TO 80041
03700	1111	MODE=1
03800		REND=2
03900		IZ=0
04000		RETURN
04200	C   ABOVE ALLOWS MORE STAVES TO BE READ
04300	
04800	80053	FORMAT(' TYPE STAFF NUM. '$)
04900	80051	FORMAT('+AND FILE NAME  '$)
05000	80052	FORMAT(F,A5)
05010	444	FORMAT(' SPACING STAFF =',F3.0)
05100	
05400	4	TYPE 8002
05500	330	ACCEPT 2114,N,L,INP3
05600	CC	IF(N.EQ.'G')GO TO 8024
05650		IF(N.EQ.'G')GO TO 69
05700	C  TYPE 'GO' TO PASS LATER ITEMS
05800		IF(N.EQ.'9')GO TO 99
05850		IF(N.EQ.'B')GO TO 99
05900		IF(N.EQ.'Y')GO TO 1
05925		IF(L.EQ.'B')GO TO 134
05931		IF(INP3.EQ.'B')GO TO 134
05937	C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
05950		IF(N.EQ.'N')GO TO 2000
05962		IF(N.NE.IBLA)GO TO 11
05975	C  PICKS UP TYPOS
06000	2000	MODE=MODE+1
06100		GO TO 11
06150	69	REND=1
06175		RETURN
06200	3	TYPE 8023
06300		GO TO 330
06400	5	TYPE 8022
06500		GO TO 330
06610	8024	CALL HYDPOG(3)
06655	C  ERASES NOTE NUMBERS
06800	C  JUMP IF NO STEM NORMALIZATION NEEDED
06900	C	IF(MODE.LT.3)GO TO 8006
07300	C   ADJUSTS NOTE STEMS, ETC.
07400	8006	MODE=MODE+1
07410		IF(MODE.NE.2)GO TO 177
07415		IF(RMODE2.EQ.2)GO TO 80041
07420	C   FOR NEW INPUT FORMAT -- TYPE 14 2 OR 144 -2 ETC.
07500	177	IF(IREAD)GO TO 2301
07600		IF(MODE.LE.5)RETURN
07700	68	REND=-1
07750		RETURN
07900	
08300	
09000	99	IF(INP3.EQ.'9')GO TO 999
09200	C   ELSE GET ANOTHER CHANCE TO SAY 'NO'
09300	C  99=BACKUP,  999=ESCAPE
09400		MODE=MODE-1
09600		IF(MODE.EQ.0)GO TO 999
09610		IS=ISV(MODE)
09620		GO TO 11
09650	C  INSERT BACKUP ROUTINE
09700	999	REND=99
09800		RETURN
10550	C FIX BACKUPS********
10600	
10800	8008	FORMAT(' TYPE ',I2,' RHYTHMS')
10900	8002	FORMAT(' ADD BEAMS?  '$)
11000	8022	FORMAT(' ADD SLURS?  '$)
11100	8023	FORMAT(' ADD MARKS?  '$)
11200	8011	FORMAT(1XI3,' MORE RHYTHMS NEEDED'/)
11210	8015	K=IRHY-I+1
11400		TYPE 8011,K
11500		IF(IREAD)IREAD=1
11550	C  ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
11600	2	TYPE 8008,IRHY
12000	
12350	1	ISV(MODE)=IS
12400		CALL TYPE
12410		REREAD 4177,RA,RB
12420		IF(RA.NE.444)GO TO 5177
12430		SET4=RB
12440	C CAN SET SPACER HERE
12450		GO TO 1177
12600	5177	IF(INP1.EQ.IBLA) GO TO 1
12700		IF(INP1.NE.'9')GO TO 80041
12750		IF(INP2.EQ.'9')GO TO 99
12800	C  TYPE '99' TO BACK-UP
12900	80041	IF(MODE.GE.3)GO TO 133
13100		RETRO=-1.
13200		I=1
13300		PARENS=0
13400		MOT=0
13500	      JZ=1  
13600		IAMP=0
13700	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
13800	      KL=0  
13900	      RA=0  
14000	2408	MLX=1
14100		L=-1
14110		IF(RMODE2.EQ.2)CALL PRESCN
14120	C   GO SORT OUT THE NEW FORMAT
14200		DO 2999 K=1,72
14300		N=INP(K)
14400		IF(N.EQ.IBLA)GO TO 2999
14500		L=0 
14600		IF(N.EQ.ISTAR)GO TO 277
14650		IF(N.NE.ISEMI)GO TO 2999
14700	C  READS 72 CHARS. INCLUDING *.
14800	277	INP(K+1)=ISEMI
14900		GO TO 1773
15000	C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
15100	2999	CONTINUE
15200		IF(IREAD)GO TO 8015
15210		TYPE 6999
15220		GO TO 1
15230	6999	FORMAT(' ****** TRY AGAIN ***** ')
15300	CC	GO TO 69
15400	C   ERROR IF NO '*' OR ';' AT END OF LINE.
15500	
15600	1299	IF(JZ.NE.0)GO TO 1773
15610	7773	IF(MODE.NE.2)GO TO 377
15632		IF(RMODE2.EQ.2)GO TO 77732
15655	C  ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
15700	377	IF(IREAD.EQ.0)GO TO 77731
15800	C   BYPASS IF NOT USING EDIT FILE
15900		READ(22,21141),L,INP
16000	C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
16100		GO TO 77732
16300	77731	CALL TYPE
16400		IF(INP1.EQ.IBLA)GO TO 7773
16500	77732	JM=-1
16600		JZ=0
16700		GO TO 2408
16800	C   'LISTS' MUST END WITH * 
16900	1773	JZ=0
17000		DBST=1.
17020		IF(XDBST)DBST=-DBST
17040		XDBST=0
17100	17731	ML=MLX
17200		IF(PARENS.LE.0.)GO TO 975
17300	C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
17400	3362	PARENS=0
17500		MOT=I-LMOT
17600		IF(LCNT+MOT.LT.198)GO TO 33621
17700		DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/)   / 
17800		TYPE NOMOR,JMOT
17900		GO TO 1
18000	33621	JLIST(LCNT+1)=MOT
18100		LCNT=LCNT+2
18200		DO 2140 JG=0,MOT-1
18300	2140	RLIST(LCNT+JG)=V(LMOT+JG)
18400		LCNT=LCNT+MOT
18500		IF(IAMP)GO TO 3013
18700	C  FOR CLOSE PARENS ON LAST ITEM
18800	C   STORE MOTIVE IN RLIST ARRAY
18900	
19000	975	DO 236 JDD=ML,72
19100		JD=JDD
19200		N=INP(JD)
19300	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
19400		IF(N.EQ.ILP)GO TO 477
19450		IF(N.EQ.IRP)GO TO 477
19475		IF(N.NE.ICOL)GO TO 2361
19500	477	INP(JD)=IBLA
19600		IF(N.NE.ICOL)GO TO 1113
19720		XDBST=-1.
19740		GO TO 5362
19750	C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
19760	C  SO NEXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
19780	C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
19900	C  FOR 'DOUBLE STOPS'
20000	1113	L=JD-1
20100	5113	IF(INP(L).NE.IBLA)GO TO 2113
20200		L=L-1
20300		GO TO 5113
20400	2113	IF(N.EQ.')')GO TO 3361
20500	C  ONLY ONE () AS YET,  NO NESTING
20600	1140	JMOT=INP(L)
20700	C   MOTIVE NAME
20800		DO 11401 JC=1,LCNT-1
20900		IF(JMOT.NE.JLIST(JC))GO TO 11401
21000	C  FINDS DUPLICATE IDENTIFIER
21200	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
21400	C  FOR BACKUP
21500	11401	CONTINUE
21600		JLIST(LCNT)=JMOT
21700		PARENS=-1.
21800	C   A PARENTH IS OPEN
21900		INP(L)=IBLA
22000		LMOT=I
22100	C   LMOT IS CURRENT POINT IN V ARRAY
22200		GO TO 236
22300	3361	IF(PARENS.NE.0)GO TO 33612
22400		DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
22500		TYPE WARN
22600	33611	INP(JD)=IBLA
22700		GO TO 236
22800	33612	PARENS=1.
22900	C   SETS PARENS CLOSED FLAG
23000		GO TO 33611
23100	C   NO INVERSIONS POSSIBLE NOW
23200	2361	IF(N.NE.IAT)GO TO 5361
23300		DO 113 L=1,72
23400		K=JD+L
23500	C   K IS USED AT 240!!!
23600		JG=INP(K)
23700		IF(JG.NE.NEG)GO TO 7113
23800		RETRO=0
23900		INP(K)=IBLA
24000		GO TO 113
24100	7113	IF(JG.NE.IBLA)GO TO 4113
24200	113	CONTINUE
24300	4113	DO 6361 L=1,LCNT
24400		IF(JG.NE.JLIST(L))GO TO 6361
24500		VX1=0
24600		DO 40 M=JD+2,72
24700		JG=INP(M)
24800		IF(JG.EQ.IBLA)GO TO 40
24900		IF(JG.EQ.KSLA)GO TO 140
24950		IF(JG.EQ.ISEMI)GO TO 140
24975		IF(JG.EQ.ISTAR)GO TO 140
25000		ML=M
25100		GO TO 240
25200	40	CONTINUE
25300	240	JC=JM
25400		JM=-1
25500		INP(K)=IBLA
25600		JN=0
25700	C   MUST BE ZERO IN SCANR
25800		CALL SCANR
25900		JM=JC
26000	140	JC=1
26100		KN=L+2
26210		M=KN+JLIST(L+1)
26300		IF(RETRO)GO TO 940
26400		KN=M-1
26550		M=L+1
26600		JC=-1
26700		RETRO=-1.
26800	
26900	940	Z=RLIST(KN)
27000		IF(VX1.EQ.0)GO TO 540
27100	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
27200		IF(MODE.EQ.1)GO TO 440
27300	C  MODE 1 IS NOTES, 2 IS RHY.
27400		V(I)=Z*VX1
27500		GO TO 7361
27600	440	IF(Z.EQ.85.)GO TO 540
27700		V(I)=Z+VX1
27800		GO TO 7361
27900	540	V(I)=Z
28000	7361	I=I+1
28100		KN=KN+JC
28200		IF(KN.NE.M)GO TO 940
28300	
28400		RB=V(I-1)
28600		DO 8361 L=JD,72
28700		JG=INP(L)
28800		INP(L)=IBLA
28900		IF(JG.EQ.KSLA)GO TO 9361
29000		IF(JG.EQ.ISEMI)GO TO 93611
29200	8361	IF(JG.EQ.ISTAR)IAMP=-1
29300	9361	MLX=L
29400		IF(IAMP.EQ.0)GO TO 17731
29600		JZ=-1
29700	93611	IF(IAMP)GO TO 3013
29900		GO TO 7773
30000	6361	CONTINUE
30100		TYPE 6362,JG
30200		GO TO 11402
30300	6362	FORMAT(' MOTIVIC (',A1,') NOT FOUND')
30400	C @@@@@@@@@@@@@@@@@@@@@@@@@@
30500	5361	IF(N.NE.KSLA)GO TO 636
30600	5362	MLX=JD+1
30700		JZ=-1
30800		INP(JD)=ISEMI
30900	436	IF(INP(MLX).NE.IBLA)GO TO 103
31000		MLX=MLX+1
31100		GO TO 436
31200	636	IF(N.EQ.ISEMI)GO TO 103
31300	936	IF(N.NE.IDOT)GO TO 736
31400		L=INP(JD+1)
31500		KL=NALF(L)
31600		IF(L.LE.0)GO TO 577
31650		IF(KL.LT.0)GO TO 577
31675		IF(KL.LE.9)GO TO 236
31700	C   JUMP IF IT'S A NUMBER
31800	577	IF(MODE.EQ.2)INP(JD)=1
31900	C :::::::::******* ↑↑↑↑ MODE #?
32000		GO TO 236
32100	C   CHANGES DOTTED RHYTHMS TO '1'S.
32200	736	IF(N.NE.ISTAR)GO TO 236
32300		IAMP=-1
32400		INP(JD)=ISEMI
32600		GO TO 103
32700	236	CONTINUE
     

00200	2114	FORMAT(72A1)
00300	21141	FORMAT(I,72A1)
09900	
10000	5016	IF(IAMP.GE.0)GO TO 1299
10100		IF(PARENS.NE.0)GO TO 3362
10200	C  PARENS ARE STILL OPEN?
10300		GO TO 3013
10400	103	K=INP(ML)
10500	
10600	C   LAST SECTION
10700		IF(K.EQ.ISEMI)GO TO 1014
10800	C*********** MODE #?
10900		IF(K.NE.IBLA) GO TO 1899
11000		ML=ML+1
11100		GO TO 103
11200	1899	JN=0
11300	C   MUST BE ZERO IN SCANR
11400		CALL SCANR
11500	      IF(VX1.EQ.-99.)GO TO 4022
11600		IF(MODE.NE.2)GO TO 17
11700	C*********** MODE #?
11800	2017	IF(VX1.EQ.10000.)GO TO 17
11900	      VX1=4./VX1
12000		IF(JJ.NE.1)GO TO 2014
12100		V(I)=VX1
12200		GO TO 114
12300	2014	DO 9006 L=2,JJ
12400		IF(VX(L).EQ.0)GO TO 17
12500	9006	VX1=4./VX(L)+VX1
12600		JJ=1
12700	17	V(I)=VX1
12800		IF(JJ.LE.1)GO TO 114
12900		IF(MODE.NE.1)GO TO 171
12950		IF(VX2.EQ.0)GO TO 171
13000	C  JUMP IF RHY OR 'X 4' ETC.
13100		V(I)=-(VX1/100.+VX2/10000.)
13200	C  PACKS 2 METER NUMS INTO ONE SLOT (-.1208 = 12/8)
13310	114	I=I+1
13320		GO TO 5016
13400	171	JC=1
13500		JD=VX(JJ)-1
13525		I=I+1
13550		GO TO 5005
13650	1014	JD=1
13750		JC=1
13850	C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
13950		GO TO 5005
14600	4022      JC=VX2+.3
14700	      JD=VX3-.5
14800		IF(JJ.EQ.2)JD=1
14900	C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
14910	5005	N=0
14920		DO 3005 K=I-1,1,-1
14930		IF(V(K).GT.0)N=N+1
14940	3005	IF(N.EQ.JC)GO TO 4005
14950	4005	JC=I-K
14960	C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
14970	C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
15000	      DO 1005 K=1,JD    
15100	       NL=I+JC-1  
15200	      DO 2005 L=I,NL    
15300	2005  V(L)=V(L-JC)
15400	1005      I=I+JC  
15700	      GO TO 5016  
15800	
15900	3013	IF(MODE.NE.2)GO TO 771
15950		IF(I-1.NE.IRHY)GO TO 8015
16000	C  WRONG NUMBER OF ITEMS
16100	771	V(I)=-99.
16200		IF(MODE.NE.1)GO TO 132
16300	131	CALL NOTES
16310	67	CALL NEWR
16400		GO TO 8006
16450	132	IF(IREAD.GT.0)IREAD=-1
16500		CALL RHYTH
16700	C  =50 IS RHYTHM FOR TEXT
16950		GO TO 67
16960	134	INP3='B'
16980		INP2=0
17000	C   ACCENTS ARE IN BEAMS SUBROUTINE
17100	133	CALL BEAMS
17110		IF(MODE.EQ.3)GO TO 135
17155		IF(MODE.EQ.4)IBEAM=0
17177	C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
17200		GO TO 8006
17600	135	K=IS
17700		CALL NEWR
17800		IS=K
17900	C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
18000		GO TO 8006
18100		END